home *** CD-ROM | disk | FTP | other *** search
/ 100 Best Shareware & Freeware Games / 100 Games.iso / Cards / PySol / pysol460.exe / {app} / python / DLLs / tk8.3 / text.tcl < prev    next >
Encoding:
Text File  |  2001-07-27  |  27.6 KB  |  1,066 lines
  1. # text.tcl --
  2. #
  3. # This file defines the default bindings for Tk text widgets and provides
  4. # procedures that help in implementing the bindings.
  5. #
  6. # RCS: @(#) $Id: text.tcl,v 1.12 2000/04/17 23:24:29 ericm Exp $
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. # Copyright (c) 1998 by Scriptics Corporation.
  11. #
  12. # See the file "license.terms" for information on usage and redistribution
  13. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  14. #
  15.  
  16. #-------------------------------------------------------------------------
  17. # Elements of tkPriv that are used in this file:
  18. #
  19. # afterId -        If non-null, it means that auto-scanning is underway
  20. #            and it gives the "after" id for the next auto-scan
  21. #            command to be executed.
  22. # char -        Character position on the line;  kept in order
  23. #            to allow moving up or down past short lines while
  24. #            still remembering the desired position.
  25. # mouseMoved -        Non-zero means the mouse has moved a significant
  26. #            amount since the button went down (so, for example,
  27. #            start dragging out a selection).
  28. # prevPos -        Used when moving up or down lines via the keyboard.
  29. #            Keeps track of the previous insert position, so
  30. #            we can distinguish a series of ups and downs, all
  31. #            in a row, from a new up or down.
  32. # selectMode -        The style of selection currently underway:
  33. #            char, word, or line.
  34. # x, y -        Last known mouse coordinates for scanning
  35. #            and auto-scanning.
  36. #-------------------------------------------------------------------------
  37.  
  38. #-------------------------------------------------------------------------
  39. # The code below creates the default class bindings for entries.
  40. #-------------------------------------------------------------------------
  41.  
  42. # Standard Motif bindings:
  43.  
  44. bind Text <1> {
  45.     tkTextButton1 %W %x %y
  46.     %W tag remove sel 0.0 end
  47. }
  48. bind Text <B1-Motion> {
  49.     set tkPriv(x) %x
  50.     set tkPriv(y) %y
  51.     tkTextSelectTo %W %x %y
  52. }
  53. bind Text <Double-1> {
  54.     set tkPriv(selectMode) word
  55.     tkTextSelectTo %W %x %y
  56.     catch {%W mark set insert sel.last}
  57.     catch {%W mark set anchor sel.first}
  58. }
  59. bind Text <Triple-1> {
  60.     set tkPriv(selectMode) line
  61.     tkTextSelectTo %W %x %y
  62.     catch {%W mark set insert sel.last}
  63.     catch {%W mark set anchor sel.first}
  64. }
  65. bind Text <Shift-1> {
  66.     tkTextResetAnchor %W @%x,%y
  67.     set tkPriv(selectMode) char
  68.     tkTextSelectTo %W %x %y
  69. }
  70. bind Text <Double-Shift-1>    {
  71.     set tkPriv(selectMode) word
  72.     tkTextSelectTo %W %x %y 1
  73. }
  74. bind Text <Triple-Shift-1>    {
  75.     set tkPriv(selectMode) line
  76.     tkTextSelectTo %W %x %y
  77. }
  78. bind Text <B1-Leave> {
  79.     set tkPriv(x) %x
  80.     set tkPriv(y) %y
  81.     tkTextAutoScan %W
  82. }
  83. bind Text <B1-Enter> {
  84.     tkCancelRepeat
  85. }
  86. bind Text <ButtonRelease-1> {
  87.     tkCancelRepeat
  88. }
  89. bind Text <Control-1> {
  90.     %W mark set insert @%x,%y
  91. }
  92. bind Text <Left> {
  93.     tkTextSetCursor %W insert-1c
  94. }
  95. bind Text <Right> {
  96.     tkTextSetCursor %W insert+1c
  97. }
  98. bind Text <Up> {
  99.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  100. }
  101. bind Text <Down> {
  102.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  103. }
  104. bind Text <Shift-Left> {
  105.     tkTextKeySelect %W [%W index {insert - 1c}]
  106. }
  107. bind Text <Shift-Right> {
  108.     tkTextKeySelect %W [%W index {insert + 1c}]
  109. }
  110. bind Text <Shift-Up> {
  111.     tkTextKeySelect %W [tkTextUpDownLine %W -1]
  112. }
  113. bind Text <Shift-Down> {
  114.     tkTextKeySelect %W [tkTextUpDownLine %W 1]
  115. }
  116. bind Text <Control-Left> {
  117.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  118. }
  119. bind Text <Control-Right> {
  120.     tkTextSetCursor %W [tkTextNextWord %W insert]
  121. }
  122. bind Text <Control-Up> {
  123.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  124. }
  125. bind Text <Control-Down> {
  126.     tkTextSetCursor %W [tkTextNextPara %W insert]
  127. }
  128. bind Text <Shift-Control-Left> {
  129.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  130. }
  131. bind Text <Shift-Control-Right> {
  132.     tkTextKeySelect %W [tkTextNextWord %W insert]
  133. }
  134. bind Text <Shift-Control-Up> {
  135.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  136. }
  137. bind Text <Shift-Control-Down> {
  138.     tkTextKeySelect %W [tkTextNextPara %W insert]
  139. }
  140. bind Text <Prior> {
  141.     tkTextSetCursor %W [tkTextScrollPages %W -1]
  142. }
  143. bind Text <Shift-Prior> {
  144.     tkTextKeySelect %W [tkTextScrollPages %W -1]
  145. }
  146. bind Text <Next> {
  147.     tkTextSetCursor %W [tkTextScrollPages %W 1]
  148. }
  149. bind Text <Shift-Next> {
  150.     tkTextKeySelect %W [tkTextScrollPages %W 1]
  151. }
  152. bind Text <Control-Prior> {
  153.     %W xview scroll -1 page
  154. }
  155. bind Text <Control-Next> {
  156.     %W xview scroll 1 page
  157. }
  158.  
  159. bind Text <Home> {
  160.     tkTextSetCursor %W {insert linestart}
  161. }
  162. bind Text <Shift-Home> {
  163.     tkTextKeySelect %W {insert linestart}
  164. }
  165. bind Text <End> {
  166.     tkTextSetCursor %W {insert lineend}
  167. }
  168. bind Text <Shift-End> {
  169.     tkTextKeySelect %W {insert lineend}
  170. }
  171. bind Text <Control-Home> {
  172.     tkTextSetCursor %W 1.0
  173. }
  174. bind Text <Control-Shift-Home> {
  175.     tkTextKeySelect %W 1.0
  176. }
  177. bind Text <Control-End> {
  178.     tkTextSetCursor %W {end - 1 char}
  179. }
  180. bind Text <Control-Shift-End> {
  181.     tkTextKeySelect %W {end - 1 char}
  182. }
  183.  
  184. bind Text <Tab> {
  185.     tkTextInsert %W \t
  186.     focus %W
  187.     break
  188. }
  189. bind Text <Shift-Tab> {
  190.     # Needed only to keep <Tab> binding from triggering;  doesn't
  191.     # have to actually do anything.
  192.     break
  193. }
  194. bind Text <Control-Tab> {
  195.     focus [tk_focusNext %W]
  196. }
  197. bind Text <Control-Shift-Tab> {
  198.     focus [tk_focusPrev %W]
  199. }
  200. bind Text <Control-i> {
  201.     tkTextInsert %W \t
  202. }
  203. bind Text <Return> {
  204.     tkTextInsert %W \n
  205. }
  206. bind Text <Delete> {
  207.     if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
  208.     %W delete sel.first sel.last
  209.     } else {
  210.     %W delete insert
  211.     %W see insert
  212.     }
  213. }
  214. bind Text <BackSpace> {
  215.     if {[string compare [%W tag nextrange sel 1.0 end] ""]} {
  216.     %W delete sel.first sel.last
  217.     } elseif {[%W compare insert != 1.0]} {
  218.     %W delete insert-1c
  219.     %W see insert
  220.     }
  221. }
  222.  
  223. bind Text <Control-space> {
  224.     %W mark set anchor insert
  225. }
  226. bind Text <Select> {
  227.     %W mark set anchor insert
  228. }
  229. bind Text <Control-Shift-space> {
  230.     set tkPriv(selectMode) char
  231.     tkTextKeyExtend %W insert
  232. }
  233. bind Text <Shift-Select> {
  234.     set tkPriv(selectMode) char
  235.     tkTextKeyExtend %W insert
  236. }
  237. bind Text <Control-slash> {
  238.     %W tag add sel 1.0 end
  239. }
  240. bind Text <Control-backslash> {
  241.     %W tag remove sel 1.0 end
  242. }
  243. bind Text <<Cut>> {
  244.     tk_textCut %W
  245. }
  246. bind Text <<Copy>> {
  247.     tk_textCopy %W
  248. }
  249. bind Text <<Paste>> {
  250.     tk_textPaste %W
  251. }
  252. bind Text <<Clear>> {
  253.     catch {%W delete sel.first sel.last}
  254. }
  255. bind Text <<PasteSelection>> {
  256.     if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
  257.     tkTextPaste %W %x %y
  258.     }
  259. }
  260. bind Text <Insert> {
  261.     catch {tkTextInsert %W [selection get -displayof %W]}
  262. }
  263. bind Text <KeyPress> {
  264.     tkTextInsert %W %A
  265. }
  266.  
  267. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  268. # Otherwise, if a widget binding for one of these is defined, the
  269. # <KeyPress> class binding will also fire and insert the character,
  270. # which is wrong.  Ditto for <Escape>.
  271.  
  272. bind Text <Alt-KeyPress> {# nothing }
  273. bind Text <Meta-KeyPress> {# nothing}
  274. bind Text <Control-KeyPress> {# nothing}
  275. bind Text <Escape> {# nothing}
  276. bind Text <KP_Enter> {# nothing}
  277. if {[string equal $tcl_platform(platform) "macintosh"]} {
  278.     bind Text <Command-KeyPress> {# nothing}
  279. }
  280.  
  281. # Additional emacs-like bindings:
  282.  
  283. bind Text <Control-a> {
  284.     if {!$tk_strictMotif} {
  285.     tkTextSetCursor %W {insert linestart}
  286.     }
  287. }
  288. bind Text <Control-b> {
  289.     if {!$tk_strictMotif} {
  290.     tkTextSetCursor %W insert-1c
  291.     }
  292. }
  293. bind Text <Control-d> {
  294.     if {!$tk_strictMotif} {
  295.     %W delete insert
  296.     }
  297. }
  298. bind Text <Control-e> {
  299.     if {!$tk_strictMotif} {
  300.     tkTextSetCursor %W {insert lineend}
  301.     }
  302. }
  303. bind Text <Control-f> {
  304.     if {!$tk_strictMotif} {
  305.     tkTextSetCursor %W insert+1c
  306.     }
  307. }
  308. bind Text <Control-k> {
  309.     if {!$tk_strictMotif} {
  310.     if {[%W compare insert == {insert lineend}]} {
  311.         %W delete insert
  312.     } else {
  313.         %W delete insert {insert lineend}
  314.     }
  315.     }
  316. }
  317. bind Text <Control-n> {
  318.     if {!$tk_strictMotif} {
  319.     tkTextSetCursor %W [tkTextUpDownLine %W 1]
  320.     }
  321. }
  322. bind Text <Control-o> {
  323.     if {!$tk_strictMotif} {
  324.     %W insert insert \n
  325.     %W mark set insert insert-1c
  326.     }
  327. }
  328. bind Text <Control-p> {
  329.     if {!$tk_strictMotif} {
  330.     tkTextSetCursor %W [tkTextUpDownLine %W -1]
  331.     }
  332. }
  333. bind Text <Control-t> {
  334.     if {!$tk_strictMotif} {
  335.     tkTextTranspose %W
  336.     }
  337. }
  338.  
  339. if {[string compare $tcl_platform(platform) "windows"]} {
  340. bind Text <Control-v> {
  341.     if {!$tk_strictMotif} {
  342.     tkTextScrollPages %W 1
  343.     }
  344. }
  345. }
  346.  
  347. bind Text <Meta-b> {
  348.     if {!$tk_strictMotif} {
  349.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  350.     }
  351. }
  352. bind Text <Meta-d> {
  353.     if {!$tk_strictMotif} {
  354.     %W delete insert [tkTextNextWord %W insert]
  355.     }
  356. }
  357. bind Text <Meta-f> {
  358.     if {!$tk_strictMotif} {
  359.     tkTextSetCursor %W [tkTextNextWord %W insert]
  360.     }
  361. }
  362. bind Text <Meta-less> {
  363.     if {!$tk_strictMotif} {
  364.     tkTextSetCursor %W 1.0
  365.     }
  366. }
  367. bind Text <Meta-greater> {
  368.     if {!$tk_strictMotif} {
  369.     tkTextSetCursor %W end-1c
  370.     }
  371. }
  372. bind Text <Meta-BackSpace> {
  373.     if {!$tk_strictMotif} {
  374.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  375.     }
  376. }
  377. bind Text <Meta-Delete> {
  378.     if {!$tk_strictMotif} {
  379.     %W delete [tkTextPrevPos %W insert tcl_startOfPreviousWord] insert
  380.     }
  381. }
  382.  
  383. # Macintosh only bindings:
  384.  
  385. # if text black & highlight black -> text white, other text the same
  386. if {[string equal $tcl_platform(platform) "macintosh"]} {
  387. bind Text <FocusIn> {
  388.     %W tag configure sel -borderwidth 0
  389.     %W configure -selectbackground systemHighlight -selectforeground systemHighlightText
  390. }
  391. bind Text <FocusOut> {
  392.     %W tag configure sel -borderwidth 1
  393.     %W configure -selectbackground white -selectforeground black
  394. }
  395. bind Text <Option-Left> {
  396.     tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  397. }
  398. bind Text <Option-Right> {
  399.     tkTextSetCursor %W [tkTextNextWord %W insert]
  400. }
  401. bind Text <Option-Up> {
  402.     tkTextSetCursor %W [tkTextPrevPara %W insert]
  403. }
  404. bind Text <Option-Down> {
  405.     tkTextSetCursor %W [tkTextNextPara %W insert]
  406. }
  407. bind Text <Shift-Option-Left> {
  408.     tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
  409. }
  410. bind Text <Shift-Option-Right> {
  411.     tkTextKeySelect %W [tkTextNextWord %W insert]
  412. }
  413. bind Text <Shift-Option-Up> {
  414.     tkTextKeySelect %W [tkTextPrevPara %W insert]
  415. }
  416. bind Text <Shift-Option-Down> {
  417.     tkTextKeySelect %W [tkTextNextPara %W insert]
  418. }
  419.  
  420. # End of Mac only bindings
  421. }
  422.  
  423. # A few additional bindings of my own.
  424.  
  425. bind Text <Control-h> {
  426.     if {!$tk_strictMotif} {
  427.     if {[%W compare insert != 1.0]} {
  428.         %W delete insert-1c
  429.         %W see insert
  430.     }
  431.     }
  432. }
  433. bind Text <2> {
  434.     if {!$tk_strictMotif} {
  435.     %W scan mark %x %y
  436.     set tkPriv(x) %x
  437.     set tkPriv(y) %y
  438.     set tkPriv(mouseMoved) 0
  439.     }
  440. }
  441. bind Text <B2-Motion> {
  442.     if {!$tk_strictMotif} {
  443.     if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} {
  444.         set tkPriv(mouseMoved) 1
  445.     }
  446.     if {$tkPriv(mouseMoved)} {
  447.         %W scan dragto %x %y
  448.     }
  449.     }
  450. }
  451. set tkPriv(prevPos) {}
  452.  
  453. # The MouseWheel will typically only fire on Windows.  However,
  454. # someone could use the "event generate" command to produce one
  455. # on other platforms.
  456.  
  457. bind Text <MouseWheel> {
  458.     %W yview scroll [expr {- (%D / 120) * 4}] units
  459. }
  460.  
  461. if {[string equal "unix" $tcl_platform(platform)]} {
  462.     # Support for mousewheels on Linux/Unix commonly comes through mapping
  463.     # the wheel to the extended buttons.  If you have a mousewheel, find
  464.     # Linux configuration info at:
  465.     #    http://www.inria.fr/koala/colas/mouse-wheel-scroll/
  466.     bind Text <4> {
  467.     if {!$tk_strictMotif} {
  468.         %W yview scroll -5 units
  469.     }
  470.     }
  471.     bind Text <5> {
  472.     if {!$tk_strictMotif} {
  473.         %W yview scroll 5 units
  474.     }
  475.     }
  476. }
  477.  
  478. # tkTextClosestGap --
  479. # Given x and y coordinates, this procedure finds the closest boundary
  480. # between characters to the given coordinates and returns the index
  481. # of the character just after the boundary.
  482. #
  483. # Arguments:
  484. # w -        The text window.
  485. # x -        X-coordinate within the window.
  486. # y -        Y-coordinate within the window.
  487.  
  488. proc tkTextClosestGap {w x y} {
  489.     set pos [$w index @$x,$y]
  490.     set bbox [$w bbox $pos]
  491.     if {[string equal $bbox ""]} {
  492.     return $pos
  493.     }
  494.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  495.     return $pos
  496.     }
  497.     $w index "$pos + 1 char"
  498. }
  499.  
  500. # tkTextButton1 --
  501. # This procedure is invoked to handle button-1 presses in text
  502. # widgets.  It moves the insertion cursor, sets the selection anchor,
  503. # and claims the input focus.
  504. #
  505. # Arguments:
  506. # w -        The text window in which the button was pressed.
  507. # x -        The x-coordinate of the button press.
  508. # y -        The x-coordinate of the button press.
  509.  
  510. proc tkTextButton1 {w x y} {
  511.     global tkPriv
  512.  
  513.     set tkPriv(selectMode) char
  514.     set tkPriv(mouseMoved) 0
  515.     set tkPriv(pressX) $x
  516.     $w mark set insert [tkTextClosestGap $w $x $y]
  517.     $w mark set anchor insert
  518.     if {[string equal [$w cget -state] "normal"]} {focus $w}
  519. }
  520.  
  521. # tkTextSelectTo --
  522. # This procedure is invoked to extend the selection, typically when
  523. # dragging it with the mouse.  Depending on the selection mode (character,
  524. # word, line) it selects in different-sized units.  This procedure
  525. # ignores mouse motions initially until the mouse has moved from
  526. # one character to another or until there have been multiple clicks.
  527. #
  528. # Arguments:
  529. # w -        The text window in which the button was pressed.
  530. # x -        Mouse x position.
  531. # y -         Mouse y position.
  532.  
  533. proc tkTextSelectTo {w x y {extend 0}} {
  534.     global tkPriv tcl_platform
  535.  
  536.     set cur [tkTextClosestGap $w $x $y]
  537.     if {[catch {$w index anchor}]} {
  538.     $w mark set anchor $cur
  539.     }
  540.     set anchor [$w index anchor]
  541.     if {[$w compare $cur != $anchor] || (abs($tkPriv(pressX) - $x) >= 3)} {
  542.     set tkPriv(mouseMoved) 1
  543.     }
  544.     switch $tkPriv(selectMode) {
  545.     char {
  546.         if {[$w compare $cur < anchor]} {
  547.         set first $cur
  548.         set last anchor
  549.         } else {
  550.         set first anchor
  551.         set last $cur
  552.         }
  553.     }
  554.     word {
  555.         if {[$w compare $cur < anchor]} {
  556.         set first [tkTextPrevPos $w "$cur + 1c" tcl_wordBreakBefore]
  557.         if { !$extend } {
  558.             set last [tkTextNextPos $w "anchor" tcl_wordBreakAfter]
  559.         } else {
  560.             set last anchor
  561.         }
  562.         } else {
  563.         set last [tkTextNextPos $w "$cur - 1c" tcl_wordBreakAfter]
  564.         if { !$extend } {
  565.             set first [tkTextPrevPos $w anchor tcl_wordBreakBefore]
  566.         } else {
  567.             set first anchor
  568.         }
  569.         }
  570.     }
  571.     line {
  572.         if {[$w compare $cur < anchor]} {
  573.         set first [$w index "$cur linestart"]
  574.         set last [$w index "anchor - 1c lineend + 1c"]
  575.         } else {
  576.         set first [$w index "anchor linestart"]
  577.         set last [$w index "$cur lineend + 1c"]
  578.         }
  579.     }
  580.     }
  581.     if {$tkPriv(mouseMoved) || [string compare $tkPriv(selectMode) "char"]} {
  582.     if {[string compare $tcl_platform(platform) "unix"] \
  583.         && [$w compare $cur < anchor]} {
  584.         $w mark set insert $first
  585.     } else {
  586.         $w mark set insert $last
  587.     }
  588.     $w tag remove sel 0.0 $first
  589.     $w tag add sel $first $last
  590.     $w tag remove sel $last end
  591.     update idletasks
  592.     }
  593. }
  594.  
  595. # tkTextKeyExtend --
  596. # This procedure handles extending the selection from the keyboard,
  597. # where the point to extend to is really the boundary between two
  598. # characters rather than a particular character.
  599. #
  600. # Arguments:
  601. # w -        The text window.
  602. # index -    The point to which the selection is to be extended.
  603.  
  604. proc tkTextKeyExtend {w index} {
  605.     global tkPriv
  606.  
  607.     set cur [$w index $index]
  608.     if {[catch {$w index anchor}]} {
  609.     $w mark set anchor $cur
  610.     }
  611.     set anchor [$w index anchor]
  612.     if {[$w compare $cur < anchor]} {
  613.     set first $cur
  614.     set last anchor
  615.     } else {
  616.     set first anchor
  617.     set last $cur
  618.     }
  619.     $w tag remove sel 0.0 $first
  620.     $w tag add sel $first $last
  621.     $w tag remove sel $last end
  622. }
  623.  
  624. # tkTextPaste --
  625. # This procedure sets the insertion cursor to the mouse position,
  626. # inserts the selection, and sets the focus to the window.
  627. #
  628. # Arguments:
  629. # w -        The text window.
  630. # x, y -     Position of the mouse.
  631.  
  632. proc tkTextPaste {w x y} {
  633.     $w mark set insert [tkTextClosestGap $w $x $y]
  634.     catch {$w insert insert [selection get -displayof $w]}
  635.     if {[string equal [$w cget -state] "normal"]} {focus $w}
  636. }
  637.  
  638. # tkTextAutoScan --
  639. # This procedure is invoked when the mouse leaves a text window
  640. # with button 1 down.  It scrolls the window up, down, left, or right,
  641. # depending on where the mouse is (this information was saved in
  642. # tkPriv(x) and tkPriv(y)), and reschedules itself as an "after"
  643. # command so that the window continues to scroll until the mouse
  644. # moves back into the window or the mouse button is released.
  645. #
  646. # Arguments:
  647. # w -        The text window.
  648.  
  649. proc tkTextAutoScan {w} {
  650.     global tkPriv
  651.     if {![winfo exists $w]} return
  652.     if {$tkPriv(y) >= [winfo height $w]} {
  653.     $w yview scroll 2 units
  654.     } elseif {$tkPriv(y) < 0} {
  655.     $w yview scroll -2 units
  656.     } elseif {$tkPriv(x) >= [winfo width $w]} {
  657.     $w xview scroll 2 units
  658.     } elseif {$tkPriv(x) < 0} {
  659.     $w xview scroll -2 units
  660.     } else {
  661.     return
  662.     }
  663.     tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
  664.     set tkPriv(afterId) [after 50 [list tkTextAutoScan $w]]
  665. }
  666.  
  667. # tkTextSetCursor
  668. # Move the insertion cursor to a given position in a text.  Also
  669. # clears the selection, if there is one in the text, and makes sure
  670. # that the insertion cursor is visible.  Also, don't let the insertion
  671. # cursor appear on the dummy last line of the text.
  672. #
  673. # Arguments:
  674. # w -        The text window.
  675. # pos -        The desired new position for the cursor in the window.
  676.  
  677. proc tkTextSetCursor {w pos} {
  678.     global tkPriv
  679.  
  680.     if {[$w compare $pos == end]} {
  681.     set pos {end - 1 chars}
  682.     }
  683.     $w mark set insert $pos
  684.     $w tag remove sel 1.0 end
  685.     $w see insert
  686. }
  687.  
  688. # tkTextKeySelect
  689. # This procedure is invoked when stroking out selections using the
  690. # keyboard.  It moves the cursor to a new position, then extends
  691. # the selection to that position.
  692. #
  693. # Arguments:
  694. # w -        The text window.
  695. # new -        A new position for the insertion cursor (the cursor hasn't
  696. #        actually been moved to this position yet).
  697.  
  698. proc tkTextKeySelect {w new} {
  699.     global tkPriv
  700.  
  701.     if {[string equal [$w tag nextrange sel 1.0 end] ""]} {
  702.     if {[$w compare $new < insert]} {
  703.         $w tag add sel $new insert
  704.     } else {
  705.         $w tag add sel insert $new
  706.     }
  707.     $w mark set anchor insert
  708.     } else {
  709.     if {[$w compare $new < anchor]} {
  710.         set first $new
  711.         set last anchor
  712.     } else {
  713.         set first anchor
  714.         set last $new
  715.     }
  716.     $w tag remove sel 1.0 $first
  717.     $w tag add sel $first $last
  718.     $w tag remove sel $last end
  719.     }
  720.     $w mark set insert $new
  721.     $w see insert
  722.     update idletasks
  723. }
  724.  
  725. # tkTextResetAnchor --
  726. # Set the selection anchor to whichever end is farthest from the
  727. # index argument.  One special trick: if the selection has two or
  728. # fewer characters, just leave the anchor where it is.  In this
  729. # case it doesn't matter which point gets chosen for the anchor,
  730. # and for the things like Shift-Left and Shift-Right this produces
  731. # better behavior when the cursor moves back and forth across the
  732. # anchor.
  733. #
  734. # Arguments:
  735. # w -        The text widget.
  736. # index -    Position at which mouse button was pressed, which determines
  737. #        which end of selection should be used as anchor point.
  738.  
  739. proc tkTextResetAnchor {w index} {
  740.     global tkPriv
  741.  
  742.     if {[string equal [$w tag ranges sel] ""]} {
  743.     $w mark set anchor $index
  744.     return
  745.     }
  746.     set a [$w index $index]
  747.     set b [$w index sel.first]
  748.     set c [$w index sel.last]
  749.     if {[$w compare $a < $b]} {
  750.     $w mark set anchor sel.last
  751.     return
  752.     }
  753.     if {[$w compare $a > $c]} {
  754.     $w mark set anchor sel.first
  755.     return
  756.     }
  757.     scan $a "%d.%d" lineA chA
  758.     scan $b "%d.%d" lineB chB
  759.     scan $c "%d.%d" lineC chC
  760.     if {$lineB < $lineC+2} {
  761.     set total [string length [$w get $b $c]]
  762.     if {$total <= 2} {
  763.         return
  764.     }
  765.     if {[string length [$w get $b $a]] < ($total/2)} {
  766.         $w mark set anchor sel.last
  767.     } else {
  768.         $w mark set anchor sel.first
  769.     }
  770.     return
  771.     }
  772.     if {($lineA-$lineB) < ($lineC-$lineA)} {
  773.     $w mark set anchor sel.last
  774.     } else {
  775.     $w mark set anchor sel.first
  776.     }
  777. }
  778.  
  779. # tkTextInsert --
  780. # Insert a string into a text at the point of the insertion cursor.
  781. # If there is a selection in the text, and it covers the point of the
  782. # insertion cursor, then delete the selection before inserting.
  783. #
  784. # Arguments:
  785. # w -        The text window in which to insert the string
  786. # s -        The string to insert (usually just a single character)
  787.  
  788. proc tkTextInsert {w s} {
  789.     if {[string equal $s ""] || [string equal [$w cget -state] "disabled"]} {
  790.     return
  791.     }
  792.     catch {
  793.     if {[$w compare sel.first <= insert] \
  794.         && [$w compare sel.last >= insert]} {
  795.         $w delete sel.first sel.last
  796.     }
  797.     }
  798.     $w insert insert $s
  799.     $w see insert
  800. }
  801.  
  802. # tkTextUpDownLine --
  803. # Returns the index of the character one line above or below the
  804. # insertion cursor.  There are two tricky things here.  First,
  805. # we want to maintain the original column across repeated operations,
  806. # even though some lines that will get passed through don't have
  807. # enough characters to cover the original column.  Second, don't
  808. # try to scroll past the beginning or end of the text.
  809. #
  810. # Arguments:
  811. # w -        The text window in which the cursor is to move.
  812. # n -        The number of lines to move: -1 for up one line,
  813. #        +1 for down one line.
  814.  
  815. proc tkTextUpDownLine {w n} {
  816.     global tkPriv
  817.  
  818.     set i [$w index insert]
  819.     scan $i "%d.%d" line char
  820.     if {[string compare $tkPriv(prevPos) $i]} {
  821.     set tkPriv(char) $char
  822.     }
  823.     set new [$w index [expr {$line + $n}].$tkPriv(char)]
  824.     if {[$w compare $new == end] || [$w compare $new == "insert linestart"]} {
  825.     set new $i
  826.     }
  827.     set tkPriv(prevPos) $new
  828.     return $new
  829. }
  830.  
  831. # tkTextPrevPara --
  832. # Returns the index of the beginning of the paragraph just before a given
  833. # position in the text (the beginning of a paragraph is the first non-blank
  834. # character after a blank line).
  835. #
  836. # Arguments:
  837. # w -        The text window in which the cursor is to move.
  838. # pos -        Position at which to start search.
  839.  
  840. proc tkTextPrevPara {w pos} {
  841.     set pos [$w index "$pos linestart"]
  842.     while {1} {
  843.     if {([string equal [$w get "$pos - 1 line"] "\n"] \
  844.         && [string compare [$w get $pos] "\n"]) \
  845.         || [string equal $pos "1.0"]} {
  846.         if {[regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  847.             dummy index]} {
  848.         set pos [$w index "$pos + [lindex $index 0] chars"]
  849.         }
  850.         if {[$w compare $pos != insert] || [string equal $pos 1.0]} {
  851.         return $pos
  852.         }
  853.     }
  854.     set pos [$w index "$pos - 1 line"]
  855.     }
  856. }
  857.  
  858. # tkTextNextPara --
  859. # Returns the index of the beginning of the paragraph just after a given
  860. # position in the text (the beginning of a paragraph is the first non-blank
  861. # character after a blank line).
  862. #
  863. # Arguments:
  864. # w -        The text window in which the cursor is to move.
  865. # start -    Position at which to start search.
  866.  
  867. proc tkTextNextPara {w start} {
  868.     set pos [$w index "$start linestart + 1 line"]
  869.     while {[string compare [$w get $pos] "\n"]} {
  870.     if {[$w compare $pos == end]} {
  871.         return [$w index "end - 1c"]
  872.     }
  873.     set pos [$w index "$pos + 1 line"]
  874.     }
  875.     while {[string equal [$w get $pos] "\n"]} {
  876.     set pos [$w index "$pos + 1 line"]
  877.     if {[$w compare $pos == end]} {
  878.         return [$w index "end - 1c"]
  879.     }
  880.     }
  881.     if {[regexp -indices {^[     ]+(.)} [$w get $pos "$pos lineend"] \
  882.         dummy index]} {
  883.     return [$w index "$pos + [lindex $index 0] chars"]
  884.     }
  885.     return $pos
  886. }
  887.  
  888. # tkTextScrollPages --
  889. # This is a utility procedure used in bindings for moving up and down
  890. # pages and possibly extending the selection along the way.  It scrolls
  891. # the view in the widget by the number of pages, and it returns the
  892. # index of the character that is at the same position in the new view
  893. # as the insertion cursor used to be in the old view.
  894. #
  895. # Arguments:
  896. # w -        The text window in which the cursor is to move.
  897. # count -    Number of pages forward to scroll;  may be negative
  898. #        to scroll backwards.
  899.  
  900. proc tkTextScrollPages {w count} {
  901.     set bbox [$w bbox insert]
  902.     $w yview scroll $count pages
  903.     if {[string equal $bbox ""]} {
  904.     return [$w index @[expr {[winfo height $w]/2}],0]
  905.     }
  906.     return [$w index @[lindex $bbox 0],[lindex $bbox 1]]
  907. }
  908.  
  909. # tkTextTranspose --
  910. # This procedure implements the "transpose" function for text widgets.
  911. # It tranposes the characters on either side of the insertion cursor,
  912. # unless the cursor is at the end of the line.  In this case it
  913. # transposes the two characters to the left of the cursor.  In either
  914. # case, the cursor ends up to the right of the transposed characters.
  915. #
  916. # Arguments:
  917. # w -        Text window in which to transpose.
  918.  
  919. proc tkTextTranspose w {
  920.     set pos insert
  921.     if {[$w compare $pos != "$pos lineend"]} {
  922.     set pos [$w index "$pos + 1 char"]
  923.     }
  924.     set new [$w get "$pos - 1 char"][$w get  "$pos - 2 char"]
  925.     if {[$w compare "$pos - 1 char" == 1.0]} {
  926.     return
  927.     }
  928.     $w delete "$pos - 2 char" $pos
  929.     $w insert insert $new
  930.     $w see insert
  931. }
  932.  
  933. # tk_textCopy --
  934. # This procedure copies the selection from a text widget into the
  935. # clipboard.
  936. #
  937. # Arguments:
  938. # w -        Name of a text widget.
  939.  
  940. proc tk_textCopy w {
  941.     if {![catch {set data [$w get sel.first sel.last]}]} {
  942.     clipboard clear -displayof $w
  943.     clipboard append -displayof $w $data
  944.     }
  945. }
  946.  
  947. # tk_textCut --
  948. # This procedure copies the selection from a text widget into the
  949. # clipboard, then deletes the selection (if it exists in the given
  950. # widget).
  951. #
  952. # Arguments:
  953. # w -        Name of a text widget.
  954.  
  955. proc tk_textCut w {
  956.     if {![catch {set data [$w get sel.first sel.last]}]} {
  957.     clipboard clear -displayof $w
  958.     clipboard append -displayof $w $data
  959.     $w delete sel.first sel.last
  960.     }
  961. }
  962.  
  963. # tk_textPaste --
  964. # This procedure pastes the contents of the clipboard to the insertion
  965. # point in a text widget.
  966. #
  967. # Arguments:
  968. # w -        Name of a text widget.
  969.  
  970. proc tk_textPaste w {
  971.     global tcl_platform
  972.     catch {
  973.     if {[string compare $tcl_platform(platform) "unix"]} {
  974.         catch {
  975.         $w delete sel.first sel.last
  976.         }
  977.     }
  978.     $w insert insert [selection get -displayof $w -selection CLIPBOARD]
  979.     }
  980. }
  981.  
  982. # tkTextNextWord --
  983. # Returns the index of the next word position after a given position in the
  984. # text.  The next word is platform dependent and may be either the next
  985. # end-of-word position or the next start-of-word position after the next
  986. # end-of-word position.
  987. #
  988. # Arguments:
  989. # w -        The text window in which the cursor is to move.
  990. # start -    Position at which to start search.
  991.  
  992. if {[string equal $tcl_platform(platform) "windows"]}  {
  993.     proc tkTextNextWord {w start} {
  994.     tkTextNextPos $w [tkTextNextPos $w $start tcl_endOfWord] \
  995.         tcl_startOfNextWord
  996.     }
  997. } else {
  998.     proc tkTextNextWord {w start} {
  999.     tkTextNextPos $w $start tcl_endOfWord
  1000.     }
  1001. }
  1002.  
  1003. # tkTextNextPos --
  1004. # Returns the index of the next position after the given starting
  1005. # position in the text as computed by a specified function.
  1006. #
  1007. # Arguments:
  1008. # w -        The text window in which the cursor is to move.
  1009. # start -    Position at which to start search.
  1010. # op -        Function to use to find next position.
  1011.  
  1012. proc tkTextNextPos {w start op} {
  1013.     set text ""
  1014.     set cur $start
  1015.     while {[$w compare $cur < end]} {
  1016.     set text $text[$w get $cur "$cur lineend + 1c"]
  1017.     set pos [$op $text 0]
  1018.     if {$pos >= 0} {
  1019.         ## Adjust for embedded windows and images
  1020.         ## dump gives us 3 items per window/image
  1021.         set dump [$w dump -image -window $start "$start + $pos c"]
  1022.         if {[llength $dump]} {
  1023.         set pos [expr {$pos + ([llength $dump]/3)}]
  1024.         }
  1025.         return [$w index "$start + $pos c"]
  1026.     }
  1027.     set cur [$w index "$cur lineend +1c"]
  1028.     }
  1029.     return end
  1030. }
  1031.  
  1032. # tkTextPrevPos --
  1033. # Returns the index of the previous position before the given starting
  1034. # position in the text as computed by a specified function.
  1035. #
  1036. # Arguments:
  1037. # w -        The text window in which the cursor is to move.
  1038. # start -    Position at which to start search.
  1039. # op -        Function to use to find next position.
  1040.  
  1041. proc tkTextPrevPos {w start op} {
  1042.     set text ""
  1043.     set cur $start
  1044.     while {[$w compare $cur > 0.0]} {
  1045.     set text [$w get "$cur linestart - 1c" $cur]$text
  1046.     set pos [$op $text end]
  1047.     if {$pos >= 0} {
  1048.         ## Adjust for embedded windows and images
  1049.         ## dump gives us 3 items per window/image
  1050.         set dump [$w dump -image -window "$cur linestart" "$start - 1c"]
  1051.         if {[llength $dump]} {
  1052.         ## This is a hokey extra hack for control-arrow movement
  1053.         ## that should be in a while loop to be correct (hobbs)
  1054.         if {[$w compare [lindex $dump 2] > \
  1055.             "$cur linestart - 1c + $pos c"]} {
  1056.             incr pos -1
  1057.         }
  1058.         set pos [expr {$pos + ([llength $dump]/3)}]
  1059.         }
  1060.         return [$w index "$cur linestart - 1c + $pos c"]
  1061.     }
  1062.     set cur [$w index "$cur linestart - 1c"]
  1063.     }
  1064.     return 0.0
  1065. }
  1066.